home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / dev / amos / PrgCollection.lha / Remap.AMOS / Remap.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1994-03-12  |  32.4 KB  |  1,318 lines
  1. ' *************************************  
  2. ' *                                   *  
  3. ' *           Remap V1.1              *  
  4. ' *   Written by Christopher Hodges   *  
  5. ' *                                   *  
  6. ' *************************************  
  7. '
  8. Set Buffer 20
  9. Dim CO(31),RS(63),UN(31),B(15+8+6+11,3),P(4,1),AN(63),CS(31)
  10. Global CO(),B(),AC,WX,WY
  11. ALGO=1
  12. ' ALGO=0: Immer gleichschneller Remap-Plot-Algorythmus 
  13. ' ALGO=1: Unterschiedlichschneller Remap-Line-Algorythmus
  14. Gosub INIT
  15. Screen 1
  16. Amreg(1)=1
  17. Do 
  18.   If Amos Here=0 Then Gosub WORKBENCH
  19.   Multi Wait : B=0 : XM=X Mouse-128 : YM=Y Mouse-YP : M=Mouse Key : I$=Inkey$
  20.   If M Then Gosub CHECKBUT
  21.   If I$<>"" Then Gosub KEYPRESSED
  22.   If B Then Gosub MENUCHOSEN
  23. Loop 
  24. End 
  25. KEYPRESSED:
  26.   OX=Min(Max(OX+((I$=Cleft$)-(I$=Cright$))*4,0),Max(WX-(320*AX),0))
  27.   OY=Min(Max(OY+((I$=Cup$)-(I$=Cdown$))*4,0),Max(WY-(256*AY),0))
  28.   If(I$=" ") and(PAG=1) Then B=8
  29.   If(I$=" ") and(PAG=2) Then B=21
  30.   If PIC Then Screen Offset 0,OX,OY
  31. Return 
  32. MENUCHOSEN:
  33.   If B<16 Then On B Gosub LEAIFF,LEAABK,QUIT,SAVIFF,SAVABK,ABOUT,PALET,RMAP,DWNCOLOR,ANALYSIS,OPTIMIZE,SCREEFORMAT,SHOPIC,DRAG,WORKBENCH : B=0
  34.   If B>15 and B<30 Then On B-15 Gosub CHOSEXCH2,CHOSCOPY2,SORCOLS,RESTCOLS,OK,CANCEL,CHOSCOPY,CHOSEXCH,CHOSSPRE,CHOSPICK,UNDOCOLOR,RESTOR,OK,CANCEL : B=0
  35.   If B>29 Then On B-29 Gosub SETMOD,SETMOD,SETMOD,SETMOD,SETCOL,SETCOL,SETCOL,SETCOL,SETCOL,OK,CANCEL : B=0
  36. Return 
  37. ABOUT:
  38.   Gosub DISABLE : Amreg(1)=2
  39.   Screen Hide 1 : If PIC Then Screen Hide 0
  40.   For A=0 To 31 : UN(A)=Colour(A) : Next 
  41.   Unpack 14 To 2 : Screen Hide 2
  42.   Screen 1 : Get Palette 2
  43.   Screen 2 : For A=0 To 15 : Colour A,0 : Next 
  44.   Y=10 : YS=0 : Wait Vbl 
  45.   Fade 4 To 1 : Screen Show 2
  46.   Repeat 
  47.     Add Y,YS/2 : If Y>200 Then Y=200 : YS=Min(0,-YS+5) Else Inc YS
  48.     Screen Display 2,,Y,, : Wait Vbl 
  49.   Until YS=0 and Y=200
  50.   While Mouse Key=0 : Multi Wait : Wend 
  51.   For A=$FFF To 0 Step -$111
  52.     Colour Back A : View : Wait Vbl : Wait Vbl 
  53.     For B=0 To 7 : Colour B,A : Next 
  54.     For B=0 To 7 : Colour B+8,Max(A-B*$111,0) : Next 
  55.   Next 
  56.   Screen Close 2
  57.   Screen 1
  58.   For A=0 To 31 : Colour A,UN(A) : Next : Wait Vbl 
  59.   If PIC Then Screen Show 0
  60.   Screen Show 1 : Screen To Front 
  61.   Gosub ENABLE : Amreg(1)=1
  62. Return 
  63. OK:
  64.   PAG=1
  65. Return 
  66. CANCEL:
  67.   PAG=-1
  68. Return 
  69. DWNCOLOR:
  70.   If PIC=0 or AC=2 or SPMO>1 Then Return 
  71.   Gosub DISABLE
  72.   Screen Open 2,320,72,4,0
  73.   Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 
  74.   Screen Display 2,128,YP,320,72
  75.   Get Sprite Palette 
  76.   B[0,0,319,71]
  77.   Screen Hide 1
  78.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  79.   Amreg(1)=1
  80.   T[2,2,"ENTER THE NUMBER OF COLORS TO REDUCE TO"]
  81.   T[2,11,"OR PRESS ESC TO ABORT:"]
  82.   A$=Str$(AC)-" " : B$=" " : MO=0
  83.   Repeat 
  84.     If Amos Here=0 Then Gosub WORKBENCH
  85.     I$=Inkey$ : Multi Wait 
  86.     If(I$=>"0") and(I$<="9") Then A$=Left$(A$+I$,2)
  87.     If(Asc(I$)=8) and(A$<>"") Then A$=Left$(A$,Len(A$)-1)
  88.     If Val(A$)>32 Then A$="32"
  89.     If Val(A$)<2 and Len(A$)=2 Then A$="2"
  90.     If B$<>A$
  91.       B$=A$ : Ink 2 : Bar 178,11 To 194,20
  92.       T[178,11,A$]
  93.     End If 
  94.   Until(I$=Chr$(27)) or(I$=Chr$(13))
  95.   A=Val(A$)
  96.   Gosub DWNCOL
  97.   Screen Show 1 : Screen To Front 1
  98.   Screen Close 2
  99.   Amreg(1)=1
  100.   Limit Mouse 128,YP To 447,71+YP
  101.   Gosub ENABLE
  102. Return 
  103. DWNCOL:
  104.   If(A$="") or(I$=Chr$(27)) or A=AC Then T[2,30,"ABORTED!"] : Wait 25 : Return 
  105.   If A<2 Then T[2,30,"ILLEGAL NUMBER OF COLORS!"] : Wait 25 : Return 
  106.   If A>AC Then T[2,30,"USE SCREEN FORMAT TO INCREASE COLORS!"] : Wait 25 : Return 
  107.   RD=A
  108.   Amreg(1)=0
  109.   T[2,20,"OK. BEGINNING WORK..."]
  110.   If RD=2 Then Gosub BLKNWHI : Return 
  111.   T[2,29,"STEP 1: ANALYSING:"]
  112.   For A=0 To AC-1
  113.     AN(A)=0
  114.   Next 
  115.   Screen 0
  116.   If SPMO
  117.     For Y=0 To WY-1
  118.       For X=0 To WX-1
  119.         Inc AN(Point(X,Y) mod 32)
  120.       Next 
  121.     Next 
  122.   Else 
  123.     For Y=0 To WY-1
  124.       For X=0 To WX-1
  125.         Inc AN(Point(X,Y))
  126.       Next 
  127.     Next 
  128.   End If 
  129.   Screen 2
  130.   Amreg(1)=1
  131.   For A=0 To AC-1
  132.     UN(A)=A : CS(A)=-1
  133.     If AN(A)>0 Then CS(A)=A
  134.   Next 
  135.   Gosub COUNT
  136.   T[2,29,"STEP 1: ANALYSING:"+Str$(C)+" COLORS USED!"]
  137.   If AN(0)=0
  138.     T[2,38,"BACKGROUND NOT USED! KEEP COLOR (Y/N)?"]
  139.     Repeat 
  140.       If Amos Here=0 : Gosub WORKBENCH : End If 
  141.       I$=Upper$(Inkey$) : Multi Wait 
  142.     Until(I$="Y") or(I$="N")
  143.     If I$="Y" : AN(0)=999999 : CS(0)=0 : End If 
  144.     Ink 2 : Bar 2,38 To 317,47
  145.   End If 
  146.   Amreg(1)=0
  147.   T[2,38,"STEP 2: REDUCING COLORS:"]
  148.   Gosub DUBLE
  149.   Gosub COUNT
  150.   T[2,38,"STEP 2: REDUCING COLORS:"+Str$(C)+" COLORS."]
  151.   AA=1
  152.   While C>RD
  153.     If AA=1 Then Gosub MAJOR Else Gosub SIMILAR
  154.     AA=1-AA
  155.     Gosub COUNT
  156.     Ink 2 : Bar 194,38 To 317,47
  157.     T[2,38,"STEP 2: REDUCING COLORS:"+Str$(C)+" COLORS."]
  158.   Wend 
  159.   T[2,47,"STEP 3: REMAPPING..."]
  160.   Screen 0
  161.   B=0
  162.   For C=0 To AC-1
  163.     D=0 : AN(C)=0
  164.     For A=0 To AC-1
  165.       If UN(A)=C Then RS(A)=B : If CS(A)>-1 Then AN(B)=CO(C) : D=1
  166.     Next 
  167.     If D=1 Then Inc B
  168.   Next 
  169.   For A=0 To AC-1
  170.     UN(A)=RS(A)
  171.     Colour A,AN(A)
  172.   Next 
  173.   For A=0 To AC-1
  174.     CO(A)=Colour(A)
  175.   Next 
  176.   B=0
  177.   If ALGO=0 Then Gosub POINREMAP Else Gosub LINEREMAP
  178.   Screen 2
  179.   Amreg(1)=1
  180. Return 
  181. OPTIMIZE:
  182.   If PIC=0 or AC=2 or SPMO>0 Then Return 
  183.   Gosub DISABLE
  184.   Screen Open 2,320,72,4,0
  185.   Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 
  186.   Screen Display 2,128,YP,320,72
  187.   Get Sprite Palette 
  188.   B[0,0,319,71]
  189.   Screen Hide 1
  190.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  191.   T[2,2,"OPTIMIZE WILL DELETE ALL UNUSED AND"]
  192.   T[2,11,"DOUBLED COLORS AND CHANGE THE SCREEN"]
  193.   Amreg(1)=0
  194.   T[2,20,"FORMAT AFTERWARDS. BEGINNING WORK..."]
  195.   T[2,29,"STEP 1: ANALYSING:"]
  196.   For A=0 To AC-1
  197.     AN(A)=0
  198.   Next 
  199.   Screen 0
  200.   For Y=0 To WY-1
  201.     For X=0 To WX-1
  202.       Inc AN(Point(X,Y))
  203.     Next 
  204.   Next 
  205.   Screen 2
  206.   Amreg(1)=1
  207.   For A=0 To AC-1
  208.     UN(A)=A : CS(A)=-1
  209.     If AN(A)>0 Then CS(A)=A
  210.   Next 
  211.   Gosub COUNT
  212.   T[2,29,"STEP 1: ANALYSING:"+Str$(C)+" COLORS USED!"]
  213.   If AN(0)=0
  214.     T[2,38,"BACKGROUND NOT USED! KEEP COLOR (Y/N)?"]
  215.     Repeat 
  216.       If Amos Here=0 : Gosub WORKBENCH : End If 
  217.       I$=Upper$(Inkey$) : Multi Wait 
  218.     Until(I$="Y") or(I$="N")
  219.     If I$="Y" : AN(0)=999999 : CS(0)=0 : End If 
  220.     Ink 2 : Bar 2,38 To 317,47
  221.   End If 
  222.   Amreg(1)=0
  223.   T[2,38,"STEP 2: REDUCING COLORS:"]
  224.   Gosub DUBLE
  225.   Gosub COUNT
  226.   T[2,38,"STEP 2: REDUCING COLORS:"+Str$(C)+" COLORS."]
  227.   T[2,47,"STEP 3: REMAPPING..."]
  228.   Screen 0
  229.   B=0 : CC=C
  230.   For C=0 To AC-1
  231.     D=0 : AN(C)=0
  232.     For A=0 To AC-1
  233.       If UN(A)=C Then RS(A)=B : If CS(A)>-1 Then AN(B)=CO(C) : D=1
  234.     Next 
  235.     If D=1 Then Inc B
  236.   Next 
  237.   For A=0 To AC-1
  238.     UN(A)=RS(A)
  239.     Colour A,AN(A)
  240.   Next 
  241.   For A=0 To AC-1
  242.     CO(A)=Colour(A)
  243.   Next 
  244.   B=0
  245.   For A=0 To AC-1
  246.     If UN(A)<>A Then Exit 
  247.   Next 
  248.   If A<AC Then If ALGO=0 Then Gosub POINREMAP Else Gosub LINEREMAP
  249.   Screen 2
  250.   Screen Show 1 : Screen To Front 1
  251.   Screen Close 2
  252.   If CC>AC/2 Then Amreg(1)=1 : Limit Mouse 128,YP To 447,71+YP : Gosub ENABLE : Return 
  253.   If CC<17 Then AC=16
  254.   If CC<9 Then AC=8
  255.   If CC<5 Then AC=4
  256.   If CC<3 Then AC=2
  257.   Amreg(1)=2
  258.   Screen Open 2,WX,WY,AC,0 : Screen Hide 2
  259.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  260.   Get Palette 0
  261.   Screen Copy 0 To 2
  262.   Screen Close 0
  263.   Screen Open 0,WX,WY,AC,DI : Screen Hide 0
  264.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  265.   Screen Display 0,128,40,Min(WX/AX,320),Min(WY,256*AY)
  266.   Screen Offset 0,OX,OY
  267.   NC=AC
  268.   Get Palette 2
  269.   If AC<32 Then Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  270.   Screen Copy 2 To 0
  271.   Screen Close 2
  272.   Screen To Back 0 : Screen Show 0
  273.   Screen 1
  274.   Amreg(1)=1
  275.   Limit Mouse 128,YP To 447,71+YP
  276.   Gosub ENABLE
  277. Return 
  278. BLKNWHI:
  279.   Screen 0
  280.   Palette 0,$FFF
  281.   For A=0 To NC-1
  282.     R0=CO(A mod 32)/$100
  283.     R1=(CO(A mod 32) and $F0)/$10
  284.     R2=CO(A mod 32) mod $10
  285.     R=R0+R1+R2
  286.     If A>31 Then R=R/2
  287.     RS(A)=0
  288.     If R>4 Then RS(A)=R/5+1
  289.     If R>39 Then RS(A)=1
  290.   Next 
  291.   For Y=0 To WY-1
  292.     For X=0 To WX-1
  293.       P=RS(Point(X,Y))
  294.       If P=2 Then P=Abs((X mod 4+Y mod 4)=0)
  295.       If P=3 Then P=Abs((X+(Y mod 2)*3) mod 6=0)
  296.       If P=4 Then P=Abs((X+(Y mod 2)*2) mod 4=0)
  297.       If P=5 Then P=(X+Y) and 1
  298.       If P=6 Then P=Abs((X+(Y mod 2)*2) mod 4>0)
  299.       If P=7 Then P=Abs((X+(Y mod 2)*3) mod 6>0)
  300.       If P=8 Then P=Abs((X mod 4+Y mod 4)>0)
  301.       Plot X,Y,P
  302.     Next 
  303.   Next 
  304.   If SPMO=1 Then SPMO=0 : NC=32
  305.   CO(0)=0 : CO(1)=$FFF
  306.   Screen 2
  307. Return 
  308. SIMILAR:
  309.   R=50 : CC=-1
  310.   For A=0 To AC-1
  311.     For B=0 To AC-1
  312.       If A<>B and CS(A)>-1 and CS(B)>-1 and AN(A)<5000 Then AA1=A : AA2=B : Gosub CMPCOLS : If DDD<R Then R=DDD : CC=A
  313.     Next 
  314.   Next 
  315.   If CC=-1 Then Goto MAJOR
  316.   A=CC : Gosub CREMOVE
  317. Return 
  318. MAJOR:
  319.   R=9999999 : CC=0
  320.   For A=0 To AC-1
  321.     If AN(A)>0 and AN(A)<R Then R=AN(A) : CC=A
  322.   Next 
  323.   A=CC : Gosub CREMOVE
  324. Return 
  325. CREMOVE:
  326.   AA1=A
  327.   M=999 : CC=0
  328.   CS(A)=-1
  329.   For B=0 To AC-1
  330.     If CS(B)>0
  331.       AA2=B : Gosub CMPCOLS
  332.       If DDD<M : CC=B : M=DDD : End If 
  333.     End If 
  334.   Next 
  335.   For B=0 To AC-1
  336.     If UN(B)=A Then UN(B)=CC : Add AN(CC),AN(B) : AN(B)=0 : CS(B)=-1
  337.   Next 
  338. Return 
  339. DUBLE:
  340.   For A=0 To AC-1
  341.     For B=0 To AC-1
  342.       If UN(A)<>UN(B) and CO(UN(A))=CO(UN(B))
  343.         For C=0 To AC-1
  344.           If UN(C)=UN(B)
  345.             UN(C)=UN(A) : Add AN(A),AN(C) : CS(C)=-1 : AN(C)=0
  346.           End If 
  347.         Next 
  348.       End If 
  349.     Next 
  350.   Next 
  351. Return 
  352. COUNT:
  353.   C=0
  354.   For A=0 To AC-1
  355.     If AN(A)>0 Then Inc C
  356.   Next 
  357. Return 
  358. SCREEFORMAT:
  359.   If PIC=0 or SPMO>0 Then Return 
  360.   Gosub DISABLE
  361.   Screen Open 2,160,72,4,0
  362.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  363.   Screen Display 2,208,YP,160,72
  364.   Screen Hide 1
  365.   Amreg(1)=1
  366.   Limit Mouse 208,YP To 367,71+YP
  367.   Get Sprite Palette 
  368.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  369.   Paste Bob 0,0,38
  370.   PAG=4
  371.   C=0 : B=AC
  372.   For A=1 To 5
  373.     B=B/2 : Exit If B<2
  374.     Inc C
  375.   Next 
  376.   MO=0 : If AX=2 Then Inc MO
  377.   If AY=2 Then Add MO,2
  378.   PRESS[30+MO]
  379.   PRESS[34+C]
  380.   Repeat 
  381.     If Amos Here=0 Then Gosub WORKBENCH
  382.     Multi Wait : B=0 : XM=X Screen(X Mouse) : YM=Y Mouse-YP : M=Mouse Key : I$=Inkey$
  383.     If M Then Gosub CHECKBUT
  384.     If I$<>"" Then Gosub KEYPRESSED
  385.     If B Then Gosub MENUCHOSEN
  386.   Until Abs(PAG)=1
  387.   Screen Show 1 : Screen To Front 1
  388.   Screen Close 2
  389.   Amreg(1)=1
  390.   Limit Mouse 128,YP To 447,71+YP
  391.   If PAG=-1 Then Gosub ENABLE : MO=0 : PAG=1 : Return 
  392.   AC=1
  393.   For A=1 To C+1 : Add AC,AC : Next 
  394.   Screen Open 2,WX,WY,AC,0 : Screen Hide 2
  395.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  396.   Get Palette 0
  397.   Screen Copy 0 To 2
  398.   Screen Close 0
  399.   DI=0
  400.   If MO and 1 Then AX=2 : Add DI,$8000 Else AX=1
  401.   If MO and 2 Then AY=2 : Add DI,4 Else AY=1
  402.   Screen Open 0,WX,WY,AC,DI : Screen Hide 0
  403.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  404.   Screen Display 0,128,40,Min(WX/AX,320),Min(WY,256*AY)
  405.   Screen Offset 0,OX,OY
  406.   NC=AC : SPMO=0
  407.   Get Palette 2
  408.   If AC<32 Then Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  409.   Screen Copy 2 To 0
  410.   Screen Close 2
  411.   Screen To Back 0 : Screen Show 0
  412.   Screen 1
  413.   Gosub ENABLE
  414.   MO=0
  415. Return 
  416. SETMOD:
  417.   REALISE[30+MO]
  418.   MO=B-30
  419.   If MO and 1 and C=4
  420.     REALISE[34+C]
  421.     C=3 : PRESS[34+C]
  422.   End If 
  423.   PRESS[B]
  424. Return 
  425. SETCOL:
  426.   REALISE[34+C]
  427.   If MO and 1 Then B=Min(B,37)
  428.   C=B-34
  429.   PRESS[B]
  430. Return 
  431. ANALYSIS:
  432.   If PIC=0 or SPMO=2 Then Return 
  433.   Amreg(1)=0 : Gosub DISABLE
  434.   Screen Hide 
  435.   Screen Open 2,320,200,Max(NC,8),0
  436.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  437.   Get Palette 0
  438.   Screen Display 2,128,40,320,200
  439.   Limit Mouse 128,40 To 447,239
  440.   If AC<8 Then Colour 4,$FFF : Colour 5,$888 : Colour 6,0
  441.   B=288/NC : CC=48 : RR=0 : MM=48 : C1=0
  442.   For A=0 To Max(AC-1,7)
  443.     R0=Colour(A)/$100
  444.     R1=(Colour(A) and $F0)/$10
  445.     R2=Colour(A) mod $10
  446.     If R0+R1+R2<CC Then C2=A : CC=R0+R1+R2
  447.     If Abs(8-R0)+Abs(8-R1)+Abs(8-R2)<MM Then C1=A : MM=Abs(8-R0)+Abs(8-R1)+Abs(8-R2)
  448.     If R0+R1+R2>RR Then C0=A : RR=R0+R1+R2
  449.   Next 
  450.   For A=0 To NC-1
  451.     AN(A)=0
  452.   Next 
  453.   Cls C1
  454.   For A=0 To NC-1
  455.     If B>4
  456.       Ink C0 : Draw 17+A*B,198 To 17+A*B,192
  457.       Draw To 14+A*B+B,192
  458.       Ink C2 : Draw 15+A*B+B,193 To 15+A*B+B,199
  459.       Draw To 18+A*B,199
  460.       Ink A : Bar 18+A*B,193 To 14+A*B+B,198
  461.     Else 
  462.       Ink A : Bar 17+A*B,192 To 15+A*B+B,199
  463.     End If 
  464.   Next 
  465.   D=(WX*WY)/(NC*16)
  466.   Screen 0
  467.   For Y=0 To WY-1
  468.     For X=0 To WX-1
  469.       P=Point(X,Y)
  470.       YA=190-(AN(P)/D)
  471.       Inc AN(P)
  472.       YY=190-(AN(P)/D)
  473.       If AN(P)=1 or YA<>YY
  474.         XX=17+P*B
  475.         Screen 2 : Plot XX,YY,C0 : Draw XX,YY-1 To XX+B-3,YY-1
  476.         Plot XX+B-2,YY,C2
  477.         Ink P : Draw XX+1,YY To XX+B-3,YY : Screen 0
  478.       End If 
  479.     Next 
  480.     If Inkey$=Chr$(27) or Mouse Key Then Exit 
  481.   Next 
  482.   Screen 2
  483.   Amreg(1)=1
  484.   While Mouse Key : Multi Wait : Wend 
  485.   Repeat : Multi Wait : Until(Inkey$=Chr$(27)) or Mouse Key
  486.   Palette 0,$FFF,$AAA,$555,$F00,$F0,$F,$888
  487.   Cls 2
  488.   C0=0 : C1=0 : C2=0
  489.   For A=0 To NC-1
  490.     R0=CO(A mod 32)/$100
  491.     R1=(CO(A mod 32) and $F0)/$10
  492.     R2=CO(A mod 32) mod $10
  493.     If A>31 Then R0=R0/2 : R1=R1/2 : R2=R2/2
  494.     Add C0,R0*AN(A)
  495.     Add C1,R1*AN(A)
  496.     Add C2,R2*AN(A)
  497.   Next 
  498.   D=Max((WX*Y)/12,1)
  499.   X=18
  500.   For A=0 To 3
  501.     If A=0 Then Y=C0/D
  502.     If A=1 Then Y=C1/D
  503.     If A=2 Then Y=C2/D
  504.     If A=3 Then Y=(C0+C1+C2)/(D*3)
  505.     If Y>0
  506.       Ink 1 : Draw X,199 To X,198-Y : Draw To X+67,198-Y
  507.       Ink 3 : Draw X+68,200-Y To X+68,199
  508.       Ink 4+A : Bar X+1,199-Y To X+67,199
  509.     End If 
  510.     Add X,72
  511.   Next 
  512.   While Mouse Key : Multi Wait : Wend 
  513.   Repeat : Multi Wait : Until(Inkey$=Chr$(27)) or Mouse Key
  514.   Limit Mouse 128,YP To 447,71+YP
  515.   Screen Close 2
  516.   Screen Show 1
  517.   Gosub ENABLE
  518. Return 
  519. PALET:
  520.   If PIC=0 Then Return 
  521.   Gosub DISABLE
  522.   Unpack 15 To 2
  523.   Screen Hide 1
  524.   YPP=YP : YP=Min(YP,168)
  525.   Screen Display 2,,YP,,
  526.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  527.   Limit Mouse 224,YP To 351,YP+127
  528.   For A=0 To AC-1
  529.     RS(A)=CO(A)
  530.     UN(A)=CO(A)
  531.   Next 
  532.   Set Rainbow 0,7,128,"","",""
  533.   For A=0 To 15
  534.     Rain(0,A+3)=A*$11+$F00
  535.   Next 
  536.   D=96/AC
  537.   For A=0 To AC-1
  538.     Gosub COUP
  539.   Next 
  540.   Rainbow 0,0,YP,128
  541.   PAG=3 : MO=0
  542.   C=0 : CA=1 : R0=0 : R1=0 : R2=0
  543.   Repeat 
  544.     If Amos Here=0 Then Gosub WORKBENCH
  545.     Multi Wait : B=0 : XM=X Screen(X Mouse) : YM=Y Mouse-YP : M=Mouse Key : I$=Inkey$
  546.     If M Then Gosub CHECKBUT : If B=0 Then Gosub OTHERS
  547.     If C<>CA Then Gosub NEWCOLOR
  548.     If I$<>"" Then Gosub KEYPRESSED
  549.     If B Then Gosub MENUCHOSEN
  550.   Until Abs(PAG)=1
  551.   If PAG<0 Then Gosub RESTOR : PAG=1
  552.   Screen Show 1 : Screen To Front 1
  553.   Rainbow Del 
  554.   Screen Close 2
  555.   Wait Vbl : YP=YPP : Amreg(1)=1
  556.   Limit Mouse 128,YP To 447,71+YP
  557.   Gosub ENABLE
  558. Return 
  559. OTHERS:
  560.   If YM<23 or YM>118 Then Return 
  561.   If XM>2 and XM<22 Then C=(YM-23)/D
  562.   If XM>21 and XM<30 Then A=0 : B=R0 : R=15-((YM-23)/6) : R0=R : Gosub UPBAR
  563.   If XM>30 and XM<39 Then A=1 : B=R1 : R=15-((YM-23)/6) : R1=R : Gosub UPBAR
  564.   If XM>39 and XM<46 Then A=2 : B=R2 : R=15-((YM-23)/6) : R2=R : Gosub UPBAR
  565.   B=0
  566. Return 
  567. UPBAR:
  568.   If B=R Then Return 
  569.   Ink 0 : Bar 23+A*9,113-B*6 To 28+A*9,118-B*6
  570.   Paste Bob 23+A*9,113-R*6,14+A
  571.   CO(C)=R0*$100+R1*$10+R2 : A=C : Gosub COUP : View 
  572. Return 
  573. NEWCOLOR:
  574.   For A=0 To AC-1
  575.     UN(A)=CO(A)
  576.   Next 
  577.   Plot 3,CA*D+23,0 : Plot 19,CA*D+23
  578.   Plot 3,CA*D+22+D : Plot 19,CA*D+22+D
  579.   Bar 23,113-R0*6 To 28,118-R0*6
  580.   Bar 32,113-R1*6 To 37,118-R1*6
  581.   Bar 41,113-R2*6 To 46,118-R2*6
  582.   If MO=1 Then CO(C)=CO(CA) : Gosub CHOSCOPY : A=C : Gosub COUP
  583.   If MO=2
  584.     Swap CO(C),CO(CA) : Gosub CHOSEXCH
  585.     A=CA : Gosub COUP : A=C : Gosub COUP
  586.   End If 
  587.   If MO=3 Then O=CA : C0=R0 : C1=R1 : C2=R2
  588.   CA=C
  589.   Plot 3,CA*D+23,1 : Plot 19,CA*D+23
  590.   Plot 3,CA*D+22+D : Plot 19,CA*D+22+D
  591.   R0=CO(C)/$100
  592.   R1=(CO(C) and $F0)/$10
  593.   R2=CO(C) mod $10
  594.   Paste Bob 23,113-R0*6,14
  595.   Paste Bob 32,113-R1*6,15
  596.   Paste Bob 41,113-R2*6,16
  597.   If MO=3
  598.     If C-O
  599.       If O<C
  600.         For A=O To C
  601.           B=((A-O)*15)/(C-O)
  602.           R=((B*R0)/15)*$100+((B*R1)/15)*$10+(B*R2)/15
  603.           B=15-B
  604.           Add R,((B*C0)/15)*$100+((B*C1)/15)*$10+(B*C2)/15
  605.           CO(A)=R
  606.         Next 
  607.       Else 
  608.         For A=C To O
  609.           B=((A-C)*15)/(O-C)
  610.           R=((B*C0)/15)*$100+((B*C1)/15)*$10+(B*C2)/15
  611.           B=15-B
  612.           Add R,((B*R0)/15)*$100+((B*R1)/15)*$10+(B*R2)/15
  613.           CO(A)=R
  614.         Next 
  615.       End If 
  616.       For A=Min(O,C) To Max(C,O)
  617.         Gosub COUP
  618.       Next 
  619.     End If 
  620.     Gosub CHOSSPRE
  621.   End If 
  622.   B=0 : View 
  623. Return 
  624. UNDOCOLOR:
  625.   Ink 0 : Bar 23,113-R0*6 To 28,118-R0*6
  626.   Bar 32,113-R1*6 To 37,118-R1*6
  627.   Bar 41,113-R2*6 To 46,118-R2*6
  628.   MO=0 : Amreg(1)=1
  629.   For A=0 To AC-1
  630.     Swap CO(A),UN(A)
  631.     Gosub COUP
  632.   Next 
  633.   R0=CO(C)/$100
  634.   R1=(CO(C) and $F0)/$10
  635.   R2=CO(C) mod $10
  636.   Paste Bob 23,113-R0*6,14
  637.   Paste Bob 32,113-R1*6,15
  638.   Paste Bob 41,113-R2*6,16
  639.   View 
  640. Return 
  641. COUP:
  642.   For B=0 To D-1
  643.     Rain(0,23+A*D+B)=CO(A)
  644.   Next 
  645.   Screen 0 : Colour A,CO(A) : Screen 2
  646. Return 
  647. RESTOR:
  648.   Ink 0
  649.   Bar 23,113-R0*6 To 28,118-R0*6
  650.   Bar 32,113-R1*6 To 37,118-R1*6
  651.   Bar 41,113-R2*6 To 46,118-R2*6
  652.   For A=0 To AC-1
  653.     CO(A)=RS(A)
  654.     Gosub COUP
  655.   Next 
  656.   View 
  657.   R0=CO(C)/$100
  658.   R1=(CO(C) and $F0)/$10
  659.   R2=CO(C) mod $10
  660.   Paste Bob 23,113-R0*6,14
  661.   Paste Bob 32,113-R1*6,15
  662.   Paste Bob 41,113-R2*6,16
  663. Return 
  664. RMAP:
  665.   If PIC=0 Then Return 
  666.   Gosub DISABLE
  667.   Screen Open 2,320,40,4096,0
  668.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  669.   Screen Display 2,128,YP,320,40
  670.   Screen Hide 1
  671.   Amreg(1)=0
  672.   Get Sprite Palette 
  673.   For A=4 To 15 : Colour A,0 : Next 
  674.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  675.   C=4
  676.   For B=0 To AC-1
  677.     For A=0 To C-1
  678.       If CO(B)=Colour(A) Then Exit 
  679.     Next 
  680.     If A=C Then Colour C,CO(B) : Inc C
  681.     Exit If C>15
  682.   Next 
  683.   Limit Mouse 128,YP To 447,YP+39
  684.   Paste Bob 0,0,17
  685.   Bar AC*9+1,1 To 318,24
  686.   For A=0 To AC-1
  687.     PUHAM[0,A,2+A*9,2]
  688.     RS(A)=A : CS(A)=A
  689.     PUHAM[0,A,2+A*9,17]
  690.   Next 
  691.   PAG=2 : Amreg(1)=18 : MO=1
  692.   C1=-1 : C2=-1 : C3=-1
  693.   Repeat 
  694.     If Amos Here=0 Then Gosub WORKBENCH
  695.     Multi Wait : B=0 : XM=X Screen(X Mouse) : YM=Y Mouse-YP : M=Mouse Key : I$=Inkey$
  696.     If M Then Gosub CHECKBUT : If B=0 Then Gosub SELCOL
  697.     If I$<>"" Then Gosub KEYPRESSED
  698.     If B Then Gosub MENUCHOSEN
  699.   Until Abs(PAG)=1
  700.   If C1>-1 Then AA=C1 : Gosub REST : C1=-1
  701.   If C2>-1 Then AA=RS(C2) : Gosub REST : C2=-1
  702.   If C3>-1 Then AA=RS(C3) : Gosub REST : C3=-1
  703.   For A=0 To AC-1
  704.     If RS(A)<>A Then Exit 
  705.   Next 
  706.   If PAG=-1 or A=AC
  707.     Screen Show 1 : Screen To Front 1
  708.     Screen Close 2
  709.     Amreg(1)=1 : PAG=1
  710.     Limit Mouse 128,YP To 447,71+YP
  711.     Gosub ENABLE
  712.     Return 
  713.   End If 
  714.   Screen Close 2
  715.   Amreg(1)=0
  716.   Screen 0
  717.   Limit Mouse 128,40 To 127+Min(WX/AX,320),39+Min(WY/AY,256*AY)
  718.   For A=0 To AC-1
  719.     For B=0 To AC-1
  720.       If RS(B)=A Then If CS(B)=RS(B) Then Colour B,CO(A) : UN(A)=B Else UN(B)=A
  721.     Next 
  722.   Next 
  723.   For A=0 To AC-1
  724.     CO(A)=Colour(A)
  725.   Next 
  726.   If ALGO=0 Then Gosub POINREMAP Else Gosub LINEREMAP
  727.   Amreg(1)=1
  728.   Screen Show 1 : Screen To Front 1
  729.   Screen 1
  730.   Limit Mouse 128,YP To 447,71+YP
  731.   Gosub ENABLE
  732. Return 
  733. POINREMAP:
  734.   If SPMO=1 Then Goto POINREMAPEHB
  735.   If SPMO=2 Then Goto POINREMAPHAM
  736.   For Y=0 To WY-1
  737.     For X=0 To WX-1
  738.       Plot X,Y,UN(Point(X,Y))
  739.     Next 
  740.   Next 
  741. Return 
  742. POINREMAPEHB:
  743.   For Y=0 To WY-1
  744.     For X=0 To WX-1
  745.       P=Point(X,Y)
  746.       Plot X,Y,UN(P mod 32)-(P>31)*32
  747.     Next 
  748.   Next 
  749. Return 
  750. POINREMAPHAM:
  751.   For Y=0 To WY-1
  752.     For X=0 To WX-1
  753.       P=Point(X,Y)
  754.       If P<16 Then Plot X,Y,UN(P)
  755.     Next 
  756.   Next 
  757. Return 
  758. LINEREMAP:
  759.   If SPMO=1 Then Goto LINEREMAPEHB
  760.   If SPMO=2 Then Goto LINEREMAPHAM
  761.   For Y=0 To WY-1
  762.     P=Point(0,Y) : XS=0
  763.     For X=1 To WX-1
  764.       PP=Point(X,Y)
  765.       If PP<>P Then Gosub DRCOL : XS=X : P=PP
  766.     Next 
  767.     Gosub DRCOL
  768.   Next 
  769. Return 
  770. DRCOL:
  771.   If UN(P)=P Then Return 
  772.   If X-XS>1 Then Ink UN(P) : Draw XS,Y To X-1,Y Else Plot XS,Y,UN(P)
  773. Return 
  774. LINEREMAPEHB:
  775.   For Y=0 To WY-1
  776.     P=Point(0,Y) : XS=0
  777.     For X=1 To WX-1
  778.       PP=Point(X,Y)
  779.       If PP<>P Then Gosub DRCOLEHB : XS=X : P=PP
  780.     Next 
  781.     Gosub DRCOLEHB
  782.   Next 
  783. Return 
  784. DRCOLEHB:
  785.   PPP=UN(P mod 32)-(P>31)*32
  786.   If X-XS>1 Then Ink PPP : Draw XS,Y To X-1,Y Else Plot XS,Y,PPP
  787. Return 
  788. LINEREMAPHAM:
  789.   For Y=0 To WY-1
  790.     P=Point(0,Y) : XS=0
  791.     For X=1 To WX-1
  792.       PP=Point(X,Y)
  793.       If PP<>P
  794.         If P<16
  795.           Gosub DRCOL
  796.         End If 
  797.         XS=X : P=PP
  798.       End If 
  799.     Next 
  800.     If P<16 Then Gosub DRCOL
  801.   Next 
  802. Return 
  803. SELCOL:
  804.   C=(XM-2)/9
  805.   If XM>2 and XM<AC*9 and YM>2 and YM<10 and MO=2
  806.     If C1>-1
  807.       AA=C1 : Gosub REST
  808.       PUHAM[0,C1,2+C1*9,2]
  809.     End If 
  810.     C1=C
  811.     If C2>-1
  812.       AA=RS(C2) : Gosub REST
  813.       RS(C2)=C1
  814.       PUHAM[0,RS(C2),2+C2*9,17]
  815.       C1=-1 : C2=-1
  816.     Else 
  817.       AA=C1 : Gosub FLS3
  818.       PUHAM[1,C1,2+C1*9,2]
  819.     End If 
  820.   End If 
  821.   If XM>2 and XM<AC*9 and YM>16 and YM<25
  822.     If MO=2 : Gosub COPCOL : Else Gosub EXCCOL : End If 
  823.   End If 
  824.   While Mouse Key : Multi Wait : Wend 
  825. Return 
  826. EXCCOL:
  827.   If C1>-1
  828.     AA=RS(C1) : Gosub REST
  829.     PUHAM[0,RS(C1),2+C1*9,17]
  830.     C1=-1
  831.   End If 
  832.   If C2>-1
  833.     C3=C
  834.     AA=RS(C2) : Gosub REST
  835.     Swap RS(C2),RS(C3) : Swap CS(C2),CS(C3)
  836.     PUHAM[0,RS(C2),2+C2*9,17]
  837.     PUHAM[0,RS(C3),2+C3*9,17]
  838.     C2=-1 : C3=-1
  839.   Else 
  840.     C2=C
  841.     PUHAM[1,RS(C2),2+C2*9,17]
  842.     AA=RS(C2) : Gosub FLS
  843.   End If 
  844. Return 
  845. COPCOL:
  846.   If C2>-1
  847.     AA=RS(C2) : Gosub REST
  848.     PUHAM[0,RS(C2),2+C2*9,17]
  849.   End If 
  850.   C2=C
  851.   If MO=2 and C1>-1
  852.     AA=C1 : Gosub REST
  853.     AA=RS(C2) : Gosub REST
  854.     RS(C2)=C1
  855.     PUHAM[0,C1,2+C1*9,2]
  856.     PUHAM[0,RS(C2),2+C2*9,17]
  857.     C1=-1 : C2=-1
  858.   Else 
  859.     PUHAM[1,RS(C2),2+C2*9,17]
  860.     AA=RS(C2) : Gosub FLS2
  861.   End If 
  862. Return 
  863. CMPCOLS:
  864.   RR0=CO(AA1)/$100
  865.   RR1=(CO(AA1) and $F0)/$10
  866.   RR2=CO(AA1) mod $10
  867.   CC0=RR0-(CO(AA2)/$100)
  868.   CC1=RR1-((CO(AA2) and $F0)/$10)
  869.   CC2=RR2-(CO(AA2) mod $10)
  870.   DDD=CC0*CC0+CC1*CC1+CC2*CC2
  871. Return 
  872. SORCOLS:
  873.   If MO Then Amreg(1)=0
  874.   For A=1 To AC-1
  875.     C=0
  876.     For B=1 To AC-2
  877.       R0=CO(RS(B))/$100
  878.       R1=(CO(RS(B)) and $F0)/$10
  879.       R2=CO(RS(B)) mod $10
  880.       G1=R0+R1+R2
  881.       R0=CO(RS(B+1))/$100
  882.       R1=(CO(RS(B+1)) and $F0)/$10
  883.       R2=CO(RS(B+1)) mod $10
  884.       G2=R0+R1+R2
  885.       If G1=G2 and CO(RS(B))<CO(RS(B+1)) Then Swap RS(B),RS(B+1) : Swap CS(B),CS(B+1) : C=1
  886.       If G1<G2 Then Swap RS(B),RS(B+1) : Swap CS(B),CS(B+1) : C=1
  887.     Next 
  888.     If C=0 Then Exit 
  889.   Next 
  890.   If C1>-1 Then AA=C1 : Gosub REST : PUHAM[0,C1,2+C1*9,2] : C1=-1
  891.   If C2>-1 Then AA=RS(C2) : Gosub REST : C2=-1
  892.   If C3>-1 Then AA=RS(C3) : Gosub REST : C3=-1
  893.   If MO=0 Then Return 
  894.   For A=1 To AC-1
  895.     PUHAM[0,RS(A),2+A*9,17]
  896.   Next 
  897.   If MO=1 Then Amreg(1)=18
  898.   If MO=2 Then Amreg(1)=20
  899. Return 
  900. RESTCOLS:
  901.   Amreg(1)=0
  902.   If C1>-1 Then AA=C1 : Gosub REST : PUHAM[0,C1,2+C1*9,2] : C1=-1
  903.   If C2>-1 Then AA=RS(C2) : Gosub REST : C2=-1
  904.   If C3>-1 Then AA=RS(C3) : Gosub REST : C3=-1
  905.   For A=0 To AC-1
  906.     RS(A)=A
  907.     PUHAM[0,A,2+A*9,17]
  908.   Next 
  909.   If MO=1 Then Amreg(1)=18
  910.   If MO=2 Then Amreg(1)=20
  911. Return 
  912. REST:
  913.   Screen 0 : Flash Off : Colour AA,CO(AA) : Screen 2
  914. Return 
  915. FLS:
  916.   Screen 0
  917.   Flash AA,"(000,2)(222,2)(444,2)(666,2)(888,2)(AAA,2)(CCC,2)(EEE,2)(CCC,2)(AAA,2)(888,2)(666,2)(444,2)"
  918.   Screen 2
  919. Return 
  920. FLS2:
  921.   Screen 0
  922.   Flash AA,"(000,2)(200,2)(400,2)(600,2)(800,2)(A00,2)(C00,2)(E00,2)(C00,2)(A00,2)(800,2)(600,2)(400,2)"
  923.   Screen 2
  924. Return 
  925. FLS3:
  926.   Screen 0
  927.   Flash AA,"(000,2)(020,2)(040,2)(060,2)(080,2)(0A0,2)(0C0,2)(0E0,2)(0C0,2)(0A0,2)(080,2)(060,2)(040,2)"
  928.   Screen 2
  929. Return 
  930. QUIT:
  931.   Amal Off : Sprite Off : Wait Vbl 
  932.   While Screen>-1 : Screen Close Screen : Wend 
  933.   Pop 
  934. End 
  935. SHOPIC:
  936.   If PIC=0 Then Return 
  937.   Amreg(1)=2 : Gosub DISABLE
  938.   Screen Hide 
  939.   Repeat 
  940.     Multi Wait : I$=Inkey$
  941.     OX=Min(Max(OX+((I$=Cleft$)-(I$=Cright$))*4,0),Max(WX-(320*AX),0))
  942.     OY=Min(Max(OY+((I$=Cup$)-(I$=Cdown$))*4,0),Max(WY-(256*AY),0))
  943.     Screen Offset 0,OX,OY
  944.   Until Mouse Key or(I$=Chr$(27))
  945.   Screen Show 
  946.   Amreg(1)=1 : Gosub ENABLE
  947.   While Mouse Key : Wend 
  948. Return 
  949. WORKBENCH:
  950.   Amos To Back 
  951.   If DISABL=0 Then Gosub DISABLE : DISABL=-1
  952.   Repeat 
  953.     Multi Wait 
  954.   Until Amos Here or Peek($BFEC01)=$41
  955.   If DISABL=-1 Then Gosub ENABLE
  956.   Amos To Front 
  957. Return 
  958. AUTODRAG:
  959.   If PAG=3 Then Gosub AUTODRAGPALETTE : Return 
  960.   A=YM
  961.   Limit Mouse 128,40+A To 447,224+A : Wait Vbl 
  962.   Repeat 
  963.     M=Mouse Key : YP=Y Mouse-A : Amreg(0)=YP
  964.     Multi Wait : Screen Display Screen,,YP,,
  965.     Screen Display 1,,YP,,
  966.   Until M=0
  967.   Wait Vbl : Limit Mouse 
  968. Return 
  969. AUTODRAGPALETTE:
  970.   A=YM
  971.   Limit Mouse 128,40+A To 447,168+A : Wait Vbl 
  972.   Repeat 
  973.     M=Mouse Key : YP=Y Mouse-A : Amreg(0)=YP : YPP=YP
  974.     Multi Wait : Screen Display Screen,,YP,,
  975.     Screen Display 1,,YP,,
  976.     Rainbow 0,0,YP,128
  977.   Until M=0
  978.   Wait Vbl : Limit Mouse 
  979. Return 
  980. DRAG:
  981.   A=Y Mouse-YP
  982.   Amreg(1)=2 : Limit Mouse 128,80 To 447,264 : Wait Vbl 
  983.   Y Mouse=YP+40
  984.   Repeat 
  985.     YP=Y Mouse-40 : Amreg(0)=YP
  986.     Multi Wait : Screen Display 1,128,YP,,
  987.   Until Mouse Key
  988.   While Mouse Key : Multi Wait : Wend 
  989.   Limit Mouse 128,YP To 447,71+YP : Wait Vbl 
  990.   Amreg(1)=1
  991.   Y Mouse=A+YP
  992. Return 
  993. SAVABK:
  994.   If PIC=0 Then Return 
  995.   Gosub FOBID
  996.   F$=Fsel$("*.abk","","Save as an AMOS Packed-Picture","")
  997.   If F$="" Then Gosub PERMIT : Return 
  998.   Spack 0 To 10
  999.   Save F$,10 : Erase 10
  1000.   Gosub PERMIT
  1001. Return 
  1002. SAVIFF:
  1003.   If PIC=0 Then Return 
  1004.   Gosub FOBID
  1005.   F$=Fsel$("","","Save as an IFF-Picture","")
  1006.   If F$="" Then Gosub PERMIT : Return 
  1007.   Screen 0 : Save Iff F$ : Screen 1
  1008.   Gosub PERMIT
  1009. Return 
  1010. LEAABK:
  1011.   Gosub FOBID
  1012.   F$=Fsel$("*.abk","","Load an AMOS Packed-Picture","")
  1013.   If F$="" Then Gosub PERMIT : Return 
  1014.   If Exist(F$)=0 Then Gosub PERMIT : Return 
  1015.   Load F$,10
  1016.   Unpack 10 To 0 : Screen To Back : Erase 10
  1017.   Gosub LEAPIC
  1018. Return 
  1019. LEAIFF:
  1020.   Gosub FOBID
  1021.   F$=Fsel$("","","Load an IFF-Picture","")
  1022.   If F$="" Then Gosub PERMIT : Return 
  1023.   If Exist(F$)=0 Then Gosub PERMIT : Return 
  1024.   Load Iff F$,0 : Screen Hide : Screen To Back 
  1025.   Gosub LEAPIC
  1026. Return 
  1027. LEAPIC:
  1028.   AC=Screen Colour : WX=Screen Width : WY=Screen Height
  1029.   DI=Deek(Screen Base+72)
  1030.   If DI and $8000 Then AX=2 Else AX=1
  1031.   If DI and 4 Then AY=2 Else AY=1
  1032.   OX=0 : OY=0
  1033.   If WY/AY<201 Then YP=Min(224,41+WY/AY) : Amreg(0)=YP : Screen Display 1,128,YP,, : Limit Mouse 128,YP To 447,71+YP
  1034.   Screen Display 0,128,40,Min(WX/AX,320),Min(WY,256*AY)
  1035.   Screen Offset 0,OX,OY
  1036.   NC=AC : SPMO=0
  1037.   If AC=64 Then NC=64 : AC=32 : SPMO=1
  1038.   If AC=4096 Then NC=16 : AC=16 : SPMO=2
  1039.   For A=0 To AC-1
  1040.     CO(A)=Colour(A)
  1041.   Next 
  1042.   If AC<32 Then Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  1043.   Screen Show : Screen 1
  1044.   PIC=1 : Gosub PERMIT
  1045. Return 
  1046. CHECKBUT:
  1047.   If YM<3
  1048.     Gosub AUTODRAG
  1049.     Return 
  1050.   End If 
  1051.   For A=P(PAG,0) To P(PAG,1)
  1052.     If XM>B(A,0) and XM<B(A,2) and YM>B(A,1) and YM<B(A,3) Then Exit 
  1053.   Next 
  1054.   If A=P(PAG,1)+1 Then B=0 : Return 
  1055.   B=A
  1056.   REFERT[B]
  1057.   P=1
  1058.   While Mouse Key
  1059.     Multi Wait : XM=X Screen(X Mouse) : YM=Y Mouse-YP : M=Mouse Key
  1060.     A=P
  1061.     If XM>B(B,0) and XM<B(B,2) and YM>B(B,1) and YM<B(B,3) Then P=1 Else P=0
  1062.     If P=0 and A=1 Then REFERT[B]
  1063.     If P=1 and A=0 Then REFERT[B]
  1064.   Wend 
  1065.   If P=0 Then B=0 : Return 
  1066.   REFERT[B]
  1067. Return 
  1068. CHOSEXCH2:
  1069.   MO=1 : Amreg(1)=18
  1070. Return 
  1071. CHOSCOPY2:
  1072.   MO=2 : Amreg(1)=20
  1073. Return 
  1074. CHOSCOPY:
  1075.   If MO=1 Then MO=0 : Amreg(1)=1 : Return 
  1076.   MO=1 : Amreg(1)=20
  1077. Return 
  1078. CHOSEXCH:
  1079.   If MO=2 Then MO=0 : Amreg(1)=1 : Return 
  1080.   MO=2 : Amreg(1)=18
  1081. Return 
  1082. CHOSSPRE:
  1083.   If MO=3 Then MO=0 : Amreg(1)=1 : Return 
  1084.   MO=3 : Amreg(1)=19
  1085. Return 
  1086. CHOSPICK:
  1087.   MO=0 : Amreg(1)=21
  1088.   Screen Hide 
  1089.   Rainbow 0,0,0,0
  1090.   Limit Mouse 128,40 To 127+Min(WX/AX,320),39+Min(WY/AY,256*AY)
  1091.   Screen 0
  1092.   Repeat 
  1093.     Multi Wait : XM=X Screen(X Mouse) : YM=Y Mouse-40 : M=Mouse Key : I$=Inkey$
  1094.     OX=Min(Max(OX+((I$=Cleft$)-(I$=Cright$))*4,0),Max(WX-(320*AX),0))
  1095.     OY=Min(Max(OY+((I$=Cup$)-(I$=Cdown$))*4,0),Max(WY-(256*AY),0))
  1096.     Screen Offset 0,OX,OY
  1097.   Until M or(I$=Chr$(27))
  1098.   If M=1 Then C=Point(XM,YM)
  1099.   Screen 2
  1100.   Limit Mouse 224,YP To 351,YP+127 : Wait Vbl 
  1101.   Screen Show 
  1102.   Rainbow 0,0,YP,128
  1103.   If M=1 Then Gosub NEWCOLOR
  1104.   Amreg(1)=1
  1105.   While Mouse Key : Multi Wait : Wend 
  1106. Return 
  1107. FOBID:
  1108.   Amal Freeze : Change Mouse 4 : Show 
  1109.   Sprite 2,0,0,
  1110.   Sprite 3,0,0,
  1111.   Sprite 4,0,0,
  1112.   Wait Vbl 
  1113. Return 
  1114. PERMIT:
  1115.   Hide : Amal On : Wait Vbl 
  1116. Return 
  1117. DISABLE:
  1118.   Amal Freeze 0 : Amal Freeze 1 : Amal Freeze 2
  1119.   Sprite 2,0,0,
  1120.   Sprite 3,0,0,
  1121.   Sprite 4,0,0,
  1122.   DISABL=1 : Wait Vbl 
  1123. Return 
  1124. ENABLE:
  1125.   DISABL=0 : Amal On : Wait Vbl 
  1126. Return 
  1127. INIT:
  1128.   While Screen>-1 : Screen Close Screen : Wend 
  1129.   Read B
  1130.   E=1 : PAG=1 : WX=0 : WY=0 : AX=1 : AY=1 : OX=0 : OY=0 : DI=0 : PIC=0
  1131.   For A=1 To B
  1132.     Read D
  1133.     P(A,0)=E : P(A,1)=E+D-1
  1134.     For C=1 To D
  1135.       Read B(E,0),B(E,1),B(E,2),B(E,3)
  1136.       Inc E
  1137.     Next 
  1138.   Next 
  1139.   YP=40
  1140.   Unpack 16 To 1
  1141.   Hide On : Sprite 0,0,0,1
  1142.   Sprite 2,0,0,13
  1143.   Sprite 3,0,0,13
  1144.   Sprite 4,0,0,2
  1145.   MAUS$="A: P; L X=XM; L Y=YM; L A=RB; I RB<>0 J A; L R0=0; "
  1146.   MAUS$=MAUS$+"B: P; L X=XM; L Y=YM; L A=R0/2+22; I R0=31 J C; "
  1147.   MAUS$=MAUS$+"L R0=R0+1; J D; C: L R0=0;"
  1148.   MAUS$=MAUS$+"D: I RB<>0 J A; J B; "
  1149.   EYE1$="A: L R0=XM-400/30; I R0>-3 J B L R0=-3;"
  1150.   EYE1$=EYE1$+"B: L X=R0+400; L Y=YM-RA/12+34+RA; P; J A;"
  1151.   EYE2$="A: L R0=XM-414/30; I R0>-3 J B L R0=-3;"
  1152.   EYE2$=EYE2$+"B: L X=R0+414; L Y=YM-RA/12+34+RA; P; J A;"
  1153.   WORM$="A: L Y=0; L X=0; F R0=0 T Z(127); PPPP; N R0;"
  1154.   WORM$=WORM$+"L R2=380; "
  1155.   WORM$=WORM$+"F R0=1 T 51; L A=3; F R1=1 T 5; PPP; L R2=R2-1; L X=R2; L Y=64+RA; L A=A+1; N R1;"
  1156.   WORM$=WORM$+"F R1=1 T 4; PPP; L A=A+1; L X=R2; L Y=64+RA; N R1; PPP; N R0;"
  1157.   WORM$=WORM$+"L A=2; J A;"
  1158.   Channel 3 To Sprite 0
  1159.   Channel 0 To Sprite 2
  1160.   Channel 1 To Sprite 3
  1161.   Channel 2 To Sprite 4
  1162.   Amal 0,EYE1$
  1163.   Amal 1,EYE2$
  1164.   Amal 2,WORM$
  1165.   Amal 3,MAUS$
  1166.   EYE1$="" : EYE2$="" : WORM$="" : MAUS$=""
  1167.   Amal On : Wait Vbl : Amreg(0)=YP : Amreg(1)=0
  1168.   Colour 17,$FF : Colour 18,$88 : Colour 19,$44
  1169.   Colour 23,$BBF : Colour 22,$55F : Colour 21,$F
  1170.   Colour 25,0
  1171.   Limit Mouse 128,YP To 447,71+YP
  1172. Return 
  1173. Data 4
  1174. Data 15
  1175. Data 2,25,52,36
  1176. Data 2,38,52,49
  1177. Data 2,51,52,62
  1178. Data 54,25,104,36
  1179. Data 54,38,104,49
  1180. Data 54,51,104,62
  1181. Data 106,25,180,36
  1182. Data 106,38,180,49
  1183. Data 106,51,180,62
  1184. Data 182,25,256,36
  1185. Data 182,38,256,49
  1186. Data 182,51,256,62
  1187. Data 303,25,317,38
  1188. Data 303,40,317,53
  1189. Data 303,55,317,68
  1190. Data 6
  1191. Data 2,26,86,37
  1192. Data 88,26,148,37
  1193. Data 150,26,183,37
  1194. Data 185,26,236,37
  1195. Data 238,26,275,37
  1196. Data 277,26,317,37
  1197. Data 8
  1198. Data 58,23,125,34
  1199. Data 58,36,125,47
  1200. Data 58,49,125,60
  1201. Data 58,62,125,73
  1202. Data 58,75,125,86
  1203. Data 58,88,125,99
  1204. Data 58,101,125,112
  1205. Data 58,114,125,125
  1206. Data 11
  1207. Data 2,19,79,30
  1208. Data 2,32,79,43
  1209. Data 81,19,157,30
  1210. Data 81,32,157,43
  1211. Data 2,45,31,56
  1212. Data 33,45,62,56
  1213. Data 64,45,93,56
  1214. Data 95,45,125,56
  1215. Data 127,45,157,56
  1216. Data 2,58,79,69
  1217. Data 81,58,157,69
  1218. Procedure B[X1,Y1,X2,Y2]
  1219.   Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1220.   Ink 1 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1
  1221.   Ink 3 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  1222. End Proc
  1223. Procedure T[X,Y,T$]
  1224.   Gr Writing 0
  1225.   Ink 3,2 : Text X+1,Y+7,T$
  1226.   Ink 1,2 : Text X,Y+6,T$
  1227. End Proc
  1228. Procedure PUHAM[S,C,X,Y]
  1229.   If S Then Ink 3 : R=5 Else Ink 1 : R=15
  1230.   Draw X,Y To X+6,Y
  1231.   Draw X,Y+6 To X,Y
  1232.   If S Then Ink 1 Else Ink 3
  1233.   Draw X+7,Y+1 To X+7,Y+7
  1234.   Draw X+1,Y+7 To X+7,Y+7
  1235.   For B=0 To 15
  1236.     If CO(C)=Colour(B) Then Exit 
  1237.   Next 
  1238.   Inc Y
  1239.   If B=16
  1240.     C0=CO(C)/$100
  1241.     C1=(CO(C) and $F0)/$10
  1242.     C2=CO(C) mod $10
  1243.     M=32 : CC=-1
  1244.     For B=0 To 15
  1245.       R0=Colour(B)/$100
  1246.       R1=(Colour(B) and $F0)/$10
  1247.       R2=Colour(B) mod $10
  1248.       If C0=R0 and C1=R1 and Abs(C2-R2)<M : M=Abs(C2-R2) : CC=B : I=16+C2 : End If 
  1249.       If C0=R0 and C2=R2 and Abs(C1-R1)<M : M=Abs(C1-R1) : CC=B : I=48+C1 : End If 
  1250.       If C1=R1 and C2=R2 and Abs(C0-R0)<M : M=Abs(C0-R0) : CC=B : I=32+C0 : End If 
  1251.     Next 
  1252.     If CC<0
  1253.       M=16
  1254.       For B=0 To 15
  1255.         R0=Colour(B)/$100
  1256.         R1=(Colour(B) and $F0)/$10
  1257.         R2=Colour(B) mod $10
  1258.         If Abs(R0-C0)+Abs(R1-C1)+Abs(R2-C2)<M : CC=B : End If 
  1259.       Next 
  1260.       XC=X+1
  1261.       If CC<0
  1262.         R0=R : R2=R
  1263.       Else 
  1264.         Ink CC : Draw XC,Y To XC,Y+5 : Inc XC
  1265.         R0=Colour(CC)/$100
  1266.         R2=Colour(CC) mod $10
  1267.       End If 
  1268.       If Abs(C0-R0)>Abs(C2-R2)
  1269.         If C0<>R0 : Ink 32+C0 : Draw XC,Y To XC,Y+5 : Inc XC : End If 
  1270.         If C2<>R2 : Ink 16+C2 : Draw XC,Y To XC,Y+5 : Inc XC : End If 
  1271.       Else 
  1272.         If C0<>R0 : Ink 32+C0 : Draw XC,Y To XC,Y+5 : Inc XC : End If 
  1273.         If C2<>R2 : Ink 16+C2 : Draw XC,Y To XC,Y+5 : Inc XC : End If 
  1274.       End If 
  1275.       Ink 48+C1 : Bar XC,Y To X+6,Y+5
  1276.     Else 
  1277.       Ink CC : Draw X+1,Y To X+1,Y+5
  1278.       Ink I : Bar X+2,Y To X+6,Y+5
  1279.     End If 
  1280.   Else 
  1281.     Ink B : Bar X+1,Y To X+6,Y+5
  1282.   End If 
  1283. End Proc
  1284. Procedure ALERT[T$,YES$,NO$]
  1285.   Hide 
  1286.   Screen Open 7,320,40,8,0
  1287.   Curs Off : Paper 0 : Flash Off : Cls 0
  1288.   Palette 0,$F80,$F00,$F0,$FFF
  1289.   Screen Display 7,128,-10,,
  1290.   Flash 1,"(F80,50)(000,50)"
  1291.   Ink 1 : Box 0,0 To 319,39 : Box 1,1 To 318,38
  1292.   Box 2,2 To 317,37
  1293.   Pen 4 : Locate 0,1 : Centre T$
  1294.   Pen 3 : Locate 10-Len(YES$)/2,3 : Print YES$
  1295.   Pen 2 : Locate 30-Len(NO$)/2,3 : Print NO$
  1296.   For A=-10 To 40 Step 2
  1297.     Wait Vbl : Screen Display 7,128,A,,
  1298.   Next 
  1299.   Repeat : M=Mouse Key : Until M
  1300.   For A=40 To -10 Step -2
  1301.     Wait Vbl : Screen Display 7,128,A,,
  1302.   Next 
  1303.   Screen Close 7 : Show 
  1304. End Proc[M-1]
  1305. Procedure PRESS[B]
  1306.   Ink 3 : Polyline B(B,0),B(B,3)-1 To B(B,0),B(B,1) To B(B,2)-1,B(B,1)
  1307.   Ink 1 : Polyline B(B,0)+1,B(B,3) To B(B,2),B(B,3) To B(B,2),B(B,1)+1
  1308. End Proc
  1309. Procedure REALISE[B]
  1310.   Ink 1 : Polyline B(B,0),B(B,3)-1 To B(B,0),B(B,1) To B(B,2)-1,B(B,1)
  1311.   Ink 3 : Polyline B(B,0)+1,B(B,3) To B(B,2),B(B,3) To B(B,2),B(B,1)+1
  1312. End Proc
  1313. Procedure REFERT[B]
  1314.   C1=Point(B(B,2),B(B,3))
  1315.   C2=Point(B(B,0),B(B,1))
  1316.   Ink C1 : Polyline B(B,0),B(B,3)-1 To B(B,0),B(B,1) To B(B,2)-1,B(B,1)
  1317.   Ink C2 : Polyline B(B,0)+1,B(B,3) To B(B,2),B(B,3) To B(B,2),B(B,1)+1
  1318. End Proc